-- NEEDS TO BE REVISED
-- | This program can be used to draw the output from calcEntropy.
-- Example: `./entropyCalc *.o *.hi|grep "^ "|cut -f2-|./blockDraw -`

-- TODO: maybe add a simple 2D graph with values which are encoded in
-- gray values.
{-# LANGUAGE ForeignFunctionInterface #-}

module Hexena.Cmds.BlockDraw ( run ) where

import Foreign (Ptr, withForeignPtr)
import Foreign.C.String
import Graphics.UI.SDL
import System.Environment (getArgs)
import Control.Monad (liftM)

import Hexena.Text.DrawGraph

--extern "C" void writeXPM(SDL_Surface *surf, const char *fname) {
foreign import ccall unsafe "writeXPM" writeXPM :: Ptr SurfaceStruct -> CString -> IO ()

maxHeight :: Int
maxHeight = 64

stepRight :: Int
stepRight = 10
stepDown :: Int
stepDown = 8


-- | must be used as an option for piped input, will look at using STDIN 
-- at a later date.
readC :: String -> IO String
readC fn | fn == "-" = getContents
         | otherwise = readFile fn

parse :: String -> [[Double]]
parse = map f . filter ((/=) 0 . length) . lines
    where f :: String -> [Double]
          f = map read . words

evtloop :: Event -> IO ()
evtloop Quit = return ()
evtloop NoEvent = delay 0x200 >> waitEvent >>= evtloop
evtloop (KeyDown (Keysym SDLK_ESCAPE _ _)) = return ()
evtloop _ = pollEvent >>= evtloop


draw :: Surface -> Int -> Int -> [Double] -> IO ()
draw s x y zs = drawHist s  0x37cf02fe 0x77ce00A0 x y $ map floor zs'
    where mH = fromIntegral maxHeight
          zs' = map (\z -> z * mH / maxZ) zs
          maxZ = maximum zs

drawNeg :: Surface -> Int -> Int -> [Double] -> IO ()
drawNeg s x y zs = drawHist s  0xff3702fe 0xfe77009a x y $ map floor zs'
    where mH = fromIntegral $ negate maxHeight
          zs' = map (\z -> z * mH / maxZ) zs
          maxZ = maximum zs

-- draws :: Surface -> Int -> Int -> [[Double]] -> IO ()
-- draws _ _ _ [] = return ()
-- draws s x y (z:zs) = draw s x y z >> draws s (x - stepRight) (y + stepDown) zs

draws :: Surface -> Int -> Int -> [[Double]] -> IO ()
draws s x y (z1:z2:zs) = draw s x y z1 >>
                         drawNeg s (x - 1) (y + 1) z2 >>
                         draws s (x - stepRight) (y + stepDown) zs
draws _ _ _ _ = return ()

gfxMain :: Int -> Int -> [[Double]] -> IO ()
gfxMain w h ds = do
  display <- setVideoMode w h 32 []
  draws display (w - 280) maxHeight ds
  Graphics.UI.SDL.flip display
  withForeignPtr display $ withCString "out.xpm" . writeXPM
  evtloop NoEvent


-- marked for deletion
{-main :: IO ()
main = do
  fname <- head `fmap` getArgs
  dat <- parse `fmap` readC fname
  let len = length dat
      width = 280 + len * stepRight `div` 2
      height = 2 * maxHeight + len * stepDown `div` 2
  withInit [InitVideo] $ gfxMain width height dat-}

run :: FilePath -> IO ()
run filename = do
  fileDat <- liftM parse $ readFile filename
  let fileLength = length fileDat
      width = 280 + fileLength * stepRight `div` 2
      height = 2 * maxHeight + fileLength * stepDown `div` 2
  withInit [InitVideo] $ gfxMain width height fileDat
